home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / oopwin.exe / OWWIND.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-07-08  |  7.5 KB  |  253 lines
  1. { OOP Window}
  2. { Copyright (c) 1989 by Micro System Solutions }
  3.  
  4. {$A+ align on word boundry}
  5. {$B- short circuit boolean evaluation}
  6. {$E+ coprocessor emulation on}
  7. {$F+ force far calls on - this is used for pick window }
  8. {$I- disable IO checking}
  9. {$N- do real-type calcs in software}
  10. {$O+ enable overlay code generation - used if overlays used }
  11. {$R- disable range checking}
  12. {$S- disable stack overflow checking}
  13. {$V- disable variable checking}
  14.  
  15. unit OWWind;
  16.  
  17. { Define and manipulate the file OOP window }
  18.  
  19. interface
  20.  
  21. uses
  22.     TPCrt,
  23.     TPDOS,
  24.     ColorDef,
  25.     TPInLine,
  26.     TPString,
  27.     TPEdit,
  28.     TPPick,
  29.     TPWindow,
  30.     TPVarray,
  31.     DMVars;
  32.  
  33. type
  34.     Location = object
  35.         XLow,    YLow,
  36.         XHigh,    YHigh:    Integer;
  37.         procedure Init(InitXLow, InitYLow,
  38.                         InitXHigh, InitYHigh : Integer);
  39.         function    GetX : Integer;
  40.         function    GetY : Integer;
  41.     end;
  42.  
  43.     KpWndwPtr = ^OOPWindow;
  44.  
  45.     OOPWindow  = object (Location)
  46.         Changed,                    { if OOP entries were modified }
  47.         Visible:    Boolean;        { if OOP window is displayed }
  48.         KpWndwWindowAttr,           { window color attributes }
  49.         KpWndwFrameAttr,
  50.         KpWndwHeaderAttr:    byte;
  51.  
  52.         constructor Init(    InitXLow, InitYLow,
  53.                             InitXHigh, InitYHigh:    Integer;
  54.                             WColor, FColor, HColor:    byte;
  55.                             OOPFile:    fileStr);
  56.         destructor    Done; virtual;
  57.         procedure    ShowWindow; virtual;
  58.         function     WildSearch(wStr: FileStr):    boolean; virtual;
  59.     end;
  60.  
  61. implementation
  62.  
  63. const
  64.     NumOOPFiles = 16;            { only allow 16 OOP files }
  65.     KPColors:    PickColorArray = (    WhiteOnRed,    { unselected item color }
  66.                                     WhiteOnRed,    { frame color }
  67.                                     WhiteOnRed,    { title color }
  68.                                     YellowOnBlack,    { selected item color }
  69.                                     WhiteOnLtGray,    { alternate unselected }
  70.                                     YellowOnLtGray);    { alternate selected }
  71. var
  72.     row,                        { selected row in pick window }
  73.     choice:    word;                { pick choice }
  74.     OOPFileRecord:    FileStr;    { this is the array record image }
  75.     KpWndw:        WindowPtr;        { TPro Window Pointer }
  76.     KpArray:    TpArray;        { OOP array for file names }
  77.  
  78.  
  79. {--------------------------------------------------------}
  80. { Location's method implementations:                     }
  81. {--------------------------------------------------------}
  82.  
  83. procedure Location.Init(InitXLow, InitYLow, InitXHigh, InitYHigh : Integer);
  84.  
  85. begin
  86.     XLow := InitXLow;            { initial window position }
  87.     YLow := InitYLow;            { upper left corner }
  88.     XHigh := InitXHigh;        { lower }
  89.     YHigh := InitYHigh;        {   right corner }
  90. end;
  91.  
  92. function Location.GetX : Integer;
  93. begin
  94.     GetX := XLow;
  95. end;
  96.  
  97. function Location.GetY : Integer;
  98. begin
  99.     GetY := YLow;
  100. end;
  101.  
  102.  
  103. {--------------------------------------------------------}
  104. { OOPWindows's method implementations:                       }
  105. {--------------------------------------------------------}
  106.  
  107. constructor OOPWindow.Init(InitXLow, InitYLow, InitXHigh, InitYHigh : Integer;
  108.                         WColor, FColor, HColor: byte;
  109.                         OOPFile:    fileStr);
  110. const
  111.     ClearValue:    string[12] = ' - blank -  ';            { initailize to spaces }
  112. begin
  113.     Location.Init(    InitXLow,
  114.                     InitYLow,
  115.                     InitXHigh,
  116.                     InitYHigh);    { initialize window location }
  117.     Visible := False;                { the window is not visible }
  118.     KpWndwWindowAttr := WColor;        { set window colors }
  119.     KpWndwFrameAttr  := FColor;
  120.     KpWndwHeaderAttr := HColor;
  121.     if existFile(OOPFile) then
  122.         LoadA(KpArray, OOPFile, 250)    { load OOP file }
  123.     else begin    { allocate space for 16 expanded wild card filenames }
  124.         MakeA(KpArray, 16, 1, sizeof(FileStr), OOPFile, 250);
  125.         ClearA(KpArray, ClearValue, ExactInit);    { initialize }
  126.     end;
  127. end;
  128.  
  129. destructor OOPWindow.Done;
  130. begin    { dispose of OOP array if it was ever created }
  131.     if not changed then exit;
  132.     StoreA(KpArray);        { close the array, save the file }
  133. end;
  134.  
  135. function GetwildCard(wStr: filestr):    filestr;
  136. var
  137.     point:    byte;            { location of period in filename }
  138.     filName:    string[8];    { 8 char filename only }
  139.     extname:    string[3];    { 3 char extension only }
  140. begin
  141.     if wStr = '' then begin        { null means everything }
  142.         GetWildCard := '????????.???';
  143.         exit;
  144.     end;
  145.     point := pos('.',wStr);        { find separator of filename extension}
  146.     extName := pad(justExtension(wStr),3);    { remove extension }
  147.     if point > 0 then        { if extension is present }
  148.         filName := copy(wStr,1,pred(point))    { unpack the file name }
  149.     else                                    {   - else - }
  150.         filName := copy(wStr,1,8);            { nothing to separate }
  151.     if pos('*', filName) > 0 then begin        { if filename contains an * }
  152.         delete(filName, pos('*', filName), length(filName)); { clear everything after * }
  153.         filName := padch(filName,'?', 8);    { and pad with ?'s }
  154.     end;
  155.     if pos('*', extName) > 0 then begin        { then do the same with extension }
  156.         delete(extName, pos('*', extName), length(extName));    { clear everything after * }
  157.         extName := padch(extName,'?', 3);    { adn pad with ?'s }
  158.     end;
  159.     GetWildCard := filName + '.' + extName;
  160. end;
  161.  
  162. function OOPFiles(Item:    Word):    string;
  163. begin        { return each expanded file entry }
  164.     RetA(KpArray, Item-1, 0, OOPFileRecord);    { Get the requested file mask }
  165.     OOPFiles := OOPFileRecord;
  166. end;
  167.  
  168. procedure OOPWindow.ShowWindow;
  169. var
  170.     escaped:    boolean;
  171. begin    { create the window and set visible flag }
  172.     Visible := True;            { window will be visible }
  173.     if not MakeWindow(KpWndw, XLow, YLow, XHigh, YHigh,
  174.                         true, true, false,
  175.                         KPColors[WindowAttr],
  176.                         KPColors[FrameAttr],
  177.                         KPColors[HeaderAttr],
  178.                         'OOP Files') then exit;    { make the window }
  179.     Choice := 1;        { initiate choice }
  180.     Row := 1;            {   and row }
  181.     FillPickWindow(KpWndw, @OOPFiles, NumOOPFiles,
  182.                         KPColors, Choice, Row);        { fill the window }
  183.  
  184.     repeat
  185.         PickBar(KPWndw, @OOPFiles,    NumOOPFiles,
  186.                         KPColors, false,
  187.                         Choice, Row);                { select an entry }
  188.         if PickCmdNum = PKSSelect then begin
  189.             WindowRelative := true;            { input is inside window bounds }
  190.             forceUpper := true;                { files are all upper case }
  191.             houseCursorAtEnd := false;        { don't extend entry box }
  192.             ReadString('', Row, 1, sizeof(FileStr)-1,
  193.                     KpColors[AltHigh],KpColors[AltHigh],KpColors[AltHigh],
  194.                     escaped, OOPFileRecord);
  195.             if not escaped then    begin    { expand wildcard and store in array }
  196.                 OOPFileRecord := GetWildCard(OOPFileRecord);
  197.                 SetA(KpArray, Choice-1, 0, OOPFileRecord);
  198.             end;
  199.         end;
  200.     until PickCmdNum <> PKSSelect;
  201.     DisposeWindow(EraseTopWindow);    { remove the window }
  202. end;
  203.  
  204. function OOPWindow.WildSearch(wStr: FileStr):    boolean;
  205. var
  206.     KR, i, j:    byte;
  207.     ext:    string[3];
  208.     found:    boolean;
  209.     posit:    byte;
  210. begin
  211.     found := false;
  212.     KR := 0;
  213.     repeat
  214.         RetA(KpArray, KR, 0, OOPFileRecord);    { return an array record }
  215.         posit := pos('.', OOPFileRecord);        { position of extension . }
  216.         i := 1;
  217.         repeat
  218.             if (wStr[i] = '.')                        {test end of filename }
  219.             and (OOPFileRecord[i] = '.') then i := 8
  220.             else
  221.             if (OOPFileRecord[i] = '?')
  222.             or (OOPFileRecord[i] = wStr[i]) then
  223.                 found := true                        { compares so far - }
  224.             else                                 { no compare - }
  225.                 found := false;                        { terminate check }
  226.             inc(i);
  227.         until (not found) or (i > 8);
  228.         if found = true then begin                    { compare extension }
  229.             ext := pad(justExtension(wStr),3);        { extract extension }
  230.             j := 1;
  231.             repeat
  232.                 if (OOPFileRecord[j+posit] = '?')
  233.                 or (OOPFileRecord[j+posit] = Ext[j]) then
  234.                     found := true                    { compares so far - }
  235.                 else                                { no compare - }
  236.                     found := false;                    { terminate check }
  237.             inc(j);
  238.             until (not found) or (j > 3);
  239.         end;
  240.         if found then begin                            { exit if found }
  241.             WildSearch := true;                        { check no more entries }
  242.             exit;
  243.         end;
  244.         inc(KR);                                     { to next array }
  245.     until KR = NumOOPFiles;                        { to maximum }
  246.     WildSearch := found;
  247. end;
  248.  
  249.  
  250. { No initialization section }
  251.  
  252. end.
  253.